COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	SUBR(CRE)------------------------------------------------------
C00005 00003	NSUBR(MKIMAG,FILM)------------------------------------------------
C00007 ENDMK
C⊗;
SUBR(CRE)------------------------------------------------------
BEGIN CRE;(Q1,Q2) - MAKE CRE STRUCTURE - BGB - 6 DEC 1972.
	EXTERNAL CMIN,CMAX

;BIT POSITIONS OF THE ARGUMENTS Q1 & Q2 ENABLE INTENSITY CUTS.
;	MOVE META
;	AND CTRL
;	MOVEM FNTFLG
	SETZM FNTFLG
	MOVE 1,ARG2↔MOVEM 1,Q0
	MOVE 1,ARG1
	CAIN 1,'FNT'
	GO [ SETOM FNTFLG
	     MOVSI 1,200000
	     EXCH 1,Q0
	     MOVEM 1,CHRCOD#
	     SETZ 1,
	     GO .+1]
	ANDCMI 1,377↔MOVEM 1,Q1
	SETZM CUT#

	SETQ IMAGE,{MKIMAG,FILM}
	SKIPN FNTFLG
	CALL(SEGTV)

;FIND AN INTENSITY CONTOUR ENABLE BIT.
L0:	MOVE 0,Q0↔MOVE 1,Q1
L1:	AOS 2,CUT↔LSHC 0,1↔JUMPL 0,L2
	CAMN 0,1↔JUMPE 0,L5↔GO L1

;THRESHOLD THE TVBUF
L2:	MOVEM 0,Q0↔MOVEM 1,Q1
	SKIPE FNTFLG
	GO [;OUTSTR[ASCIZ/CHARACTER = /]
	;    INCHRW CHRCOD#
	     CALL(FNTPAK,CHRCOD)
	     GO [ OUTSTR[ASCIZ/  CHARACTER NOT FOUND.	
/]↔		  POP2J]
	     CALL(DPYPAK)
	     CALL(SEGTV)
	     MOVE 1,[XWD PAK,PAC]
	     BLT 1,VSEG
	     GO L2A]
	CALL(THRESH,CUT)
L2A:	CALL(PACXOR)

;MAKE LEVEL NODE WITH A RING OF POLYGON NODES.
	SETQ(LEVEL,{MKLEVL,IMAGE,CUT})
	MOVE 0,CHRCOD		;SET CHARACTER CODE FOR
	SKIPE FNTFLG		;CHARACTERS READ FROM FILE
	NCNT. 0,1
	MOVE 0,CMAX		;REMEMBER WIDTH
	SUB 0,CMIN
	ASH 0,6
	PGON. 0,1
L3:	SETQ(POLYGON,{MKPGON,LEVEL})
	JUMPN 1,L3↔MOVE 1,LEVEL↔SON 1,1↔JUMPE 1,L0

;LEVEL OPERATIONS.
L4:
	SKIPE FNTFLG
	GO L4A
	CALL(BABYKILLER,LEVEL)
L4A:	CALL(STADPY)
	GO L0

;IMAGE OPERATIONS.
L5:	SETZ↔SKIPE FLGKRK↔CORE2↔JFCL
	MOVE 1,IMAGE↔DETSEG↔POP2J

	DECLARE{Q0,Q1}
BEND;1/10/73------------------------------------------------------
	DECLARE{IMAGE,LEVEL,POLYGON}
FNTFLG:	0
NSUBR(MKIMAG,FILM)------------------------------------------------
; MAKE IMAGE NODE - BGB - 10 JANUARY 1973.
	SETQ(IMAGE,{MAKE,[IBIT+IMGREL]})
	CALL(RINGIN,IMAGE,FILM)
	MOVE 1,IMAGE↔MOVE 2,FILM
	SON. 1,2↔DAD. 2,1
	HRLI 1,(1)↔MOVEM 1,3(1)↔MOVEM 1,4(1)↔MOVEM 1,5(1)    ;FEV-RINGS.
	POP1J
SUBREND;1/10/73---------------------------------------------------

NSUBR(MKLEVL,IMAGE,CUT)-------------------------------------------
; MAKE LEVEL NODE - BGB - 10 JANUARY 1973.
	SETQ(LEVEL,{MAKE,[LBIT+LVLREL]})
	CALL(RINGIN,LEVEL,IMAGE)
	MOVE 1,LEVEL↔MOVE 2,IMAGE
	SETO↔NCNT. 0,1
	SKIPGE↔SON. 1,2↔DAD. 2,1
	POP2J
SUBREND;1/10/73---------------------------------------------------